home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / lexscan / evalexpr.pas next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  9.9 KB  |  290 lines
  1. ========
  2. Newsgroups: comp.lang.pascal.delphi.components
  3. Subject: Lexical Scanner [1/4]
  4. From: jbui@scd.hp.com (Joseph Bui)
  5. Date: 27 Jul 1995 16:58:14 GMT
  6.  
  7. {************** EVALEXPR.PAS *******************}
  8. unit Evalexpr;
  9.  
  10. interface
  11.  
  12. uses
  13.   TypInfo, Classes, SysUtils, Lexscan, StrUtils;
  14.  
  15. type
  16.   ESyntaxError = class(Exception);
  17.  
  18. function Simplify(const Expression: string): string;
  19.  
  20. implementation
  21.  
  22. {**************************************************************}
  23. function Simplify(const Expression: string): string;
  24. {************************* Constants **************************}
  25. const
  26. {
  27.   Tokens are used when loading the value table. These should be
  28.   variables, fields or typed constants if possible.
  29. }
  30.   NotToken = #33;
  31.   AndToken = #38;
  32.   MulToken = #42;
  33.   AddToken = #43;
  34.   SubToken = #45;
  35.   DivToken = #47;
  36.   LtToken = #60;
  37.   EqToken = #61;
  38.   GtToken = #62;
  39.   PowToken = #94;
  40.   OrToken = #124;
  41. {
  42.   Chars are used when doing calculations. #0...#241 are
  43.   value table indexes. #242...#255 are operators.
  44. }
  45.   FalseStr = '0';
  46.   TrueStr = '1';
  47.   NotChar = #242;
  48.   MulChar = #243;
  49.   DivChar = #244;
  50.   PowChar = #245;
  51.   AndChar = #246;
  52.   AddChar = #247;
  53.   SubChar = #248;
  54.   OrChar = #249;
  55.   EqChar = #250;
  56.   NeqChar = #251;
  57.   LtChar = #252;
  58.   GtChar = #253;
  59.   LteChar = #254;
  60.   GteChar = #255;
  61.  
  62. {************************* Variables **************************}
  63. var
  64.   ValueTable: TStringList;
  65.   AStream: TMemoryStream;
  66.   AScanner: TStreamScanner;
  67.   Operator: byte;
  68.   Token2Char: char;
  69.   IndexL, IndexR: integer;
  70.  
  71.   {************************* TypeOf ***************************}
  72.   function TypeOf(const Index: integer): TTypeKind;
  73.   begin
  74.     if IsAnInt(ValueTable[Index]) then
  75.       Result:=tkInteger
  76.     else
  77.       if IsAFloat(ValueTable[Index]) then
  78.         Result:=tkFloat
  79.       else
  80.         Result:=tkString;
  81.   end;
  82.  
  83. {************************* Simplify ***************************}
  84. begin
  85.   try
  86.     ValueTable:=TStringList.Create;
  87.     AStream:=TMemoryStream.Create;
  88.     AStream.Write((@Expression[1])^, Length(Expression));
  89.     AScanner:=TStreamScanner.Create(AStream);
  90.     Result:=Null;
  91.  
  92.     {************** Load ValueTable and Result ****************}
  93.  
  94.     with AScanner do
  95.       repeat
  96.         case Token of
  97.           StringToken : Token2Char:=Chr(ValueTable.Add(TokenString));
  98.           IntegerToken, FloatToken :
  99.             if (Result[Length(Result)] < NotChar) and (Length(Result) > 0) then
  100.             begin
  101.               if TokenString[1] in [AddToken, SubToken] then
  102.               begin
  103.                 if TokenString[1] = AddToken then
  104.                   AppendStr(Result, AddChar)
  105.                 else
  106.                   AppendStr(Result, SubChar);
  107.                   Token2Char:=Chr(ValueTable.Add(Copy(TokenString, 2, 255)));
  108.               end
  109.               else
  110.                 raise ESyntaxError.Create('Expected operator');
  111.             end
  112.             else
  113.               Token2Char:=Chr(ValueTable.Add(TokenString));
  114.           NotToken : Token2Char:=NotChar;
  115.         else
  116.           if Result[Length(Result)] >= NotChar then
  117.             raise ESyntaxError.Create('Expected value or variable')
  118.           else
  119.             case Token of
  120.               AndToken : Token2Char:=AndChar;
  121.               MulToken : Token2Char:=MulChar;
  122.               AddToken : Token2Char:=AddChar;
  123.               SubToken : Token2Char:=SubChar;
  124.               DivToken : Token2Char:=DivChar;
  125.               LtToken :
  126.                 case NextToken of
  127.                   EqToken : Token2Char:=LteChar;
  128.                   GtToken : Token2Char:=NeqChar;
  129.                 else
  130.                   begin
  131.                     Token2Char:=LtChar;
  132.                     LastToken;
  133.                   end;
  134.                 end;
  135.               EqToken :
  136.                 if NextToken = EqToken then
  137.                   Token2Char:=EqChar
  138.                 else
  139.                   raise ESyntaxError.Create('Invalid assignment');
  140.               GtToken :
  141.                 if NextToken = EqToken then
  142.                   Token2Char:=GteChar
  143.                 else
  144.                 begin
  145.                   Token2Char:=GtChar;
  146.                   LastToken;
  147.                 end;
  148.               PowToken : Token2Char:=PowChar;
  149.               OrToken : Token2Char:=OrChar;
  150.             else
  151.               raise ESyntaxError.Create('Unknown operator');
  152.             end; {case Token of}
  153.         end; {case Token of}
  154.         AppendStr(Result, Token2Char);
  155.         NextToken;
  156.       until Token = EofToken;
  157.  
  158.     {************************* Not ****************************}
  159.     repeat
  160.       Operator:=Pos(NotChar, Result);
  161.       if Operator = Length(Result) then
  162.         raise ESyntaxError.Create('Expected value or variable');
  163.       if Operator > 0 then
  164.       begin
  165.         IndexR:=Ord(Result[Operator + 1]);
  166.         if (TypeOf(IndexR) = tkInteger) and
  167.             (StrToInt(ValueTable[IndexR]) <> 0) then
  168.           ValueTable[IndexR]:=FalseStr
  169.         else
  170.           ValueTable[IndexR]:=TrueStr;
  171.         Delete(Result, Operator, 1);
  172.       end;
  173.     until Operator = 0;
  174.  
  175.     {******************** Mul Div Pow And *********************}
  176.     repeat
  177.       Operator:=SetPos(Result, [MulChar, DivChar, PowChar, AndChar]);
  178.       if Operator = Length(Result) then
  179.         raise ESyntaxError.Create('Expected value or variable');
  180.       if Operator > 0 then
  181.       begin
  182.         IndexL:=Ord(Result[Operator - 1]);
  183.         IndexR:=Ord(Result[Operator + 1]);
  184.         case Result[Operator] of
  185.           MulChar : ValueTable[IndexL]:=FloatToStr(
  186.               StrToNum(ValueTable[IndexL]) *
  187.               StrToNum(ValueTable[IndexR]));
  188.           DivChar : ValueTable[IndexL]:=FloatToStr(
  189.               StrToNum(ValueTable[IndexL]) /
  190.               StrToNum(ValueTable[IndexR]));
  191.           PowChar : ValueTable[IndexL]:=FloatToStr(Exp(
  192.               Ln(StrToNum(ValueTable[IndexL])) *
  193.               StrToNum(ValueTable[IndexR])));
  194.           AndChar : ValueTable[IndexL]:=IntToStr(
  195.               StrToInt(ValueTable[IndexL]) and
  196.               StrToInt(ValueTable[IndexR]));
  197.         end;
  198.         Delete(Result, Operator, 2);
  199.       end;
  200.     until Operator = 0;
  201.  
  202.     {*********************** Add Sub Or ***********************}
  203.     repeat
  204.       Operator:=SetPos(Result, [AddChar, SubChar, OrChar]);
  205.       if Operator = Length(Result) then
  206.         raise ESyntaxError.Create('Expected value or variable');
  207.       if Operator > 0 then
  208.       begin
  209.         IndexL:=Ord(Result[Operator - 1]);
  210.         IndexR:=Ord(Result[Operator + 1]);
  211.         case Result[Operator] of
  212.           AddChar :
  213.             if (TypeOf(IndexL) = tkString) or (TypeOf(IndexR) = tkString) then
  214.               ValueTable[IndexL]:=ValueTable[IndexL] + ValueTable[IndexR]
  215.             else
  216.               ValueTable[IndexL]:=FloatToStr(
  217.                 StrToNum(ValueTable[IndexL]) +
  218.                 StrToNum(ValueTable[IndexR]));
  219.           SubChar : ValueTable[IndexL]:=FloatToStr(
  220.               StrToNum(ValueTable[IndexL]) -
  221.               StrToNum(ValueTable[IndexR]));
  222.           OrChar :  ValueTable[IndexL]:=IntToStr(
  223.               StrToInt(ValueTable[IndexL]) or
  224.               StrToInt(ValueTable[IndexR]));
  225.         end;
  226.         Delete(Result, Operator, 2);
  227.       end;
  228.     until Operator = 0;
  229.  
  230.     {****************** Eq Neq Lt Gt Lte Gte ******************}
  231.     repeat
  232.       Operator:=SetPos(Result,
  233.           [EqChar, NeqChar, LtChar, GtChar, LteChar, GteChar]);
  234.       if Operator = Length(Result) then
  235.         raise ESyntaxError.Create('Expected value or variable');
  236.       if Operator > 0 then
  237.       begin
  238.         IndexL:=Ord(Result[Operator - 1]);
  239.         IndexR:=Ord(Result[Operator + 1]);
  240.         if (TypeOf(IndexL) = tkString) or (TypeOf(IndexR) = tkString) then
  241.           case Result[Operator] of
  242.             EqChar : ValueTable[IndexL]:=IntToStr(byte(
  243.                 CompareStr(ValueTable[IndexL], ValueTable[IndexR]) = 0));
  244.             NeqChar : ValueTable[IndexL]:=IntToStr(byte(
  245.                 CompareStr(ValueTable[IndexL], ValueTable[IndexR]) <> 0));
  246.             LtChar : ValueTable[IndexL]:=IntToStr(byte(
  247.                 CompareStr(ValueTable[IndexL], ValueTable[IndexR]) < 0));
  248.             GtChar : ValueTable[IndexL]:=IntToStr(byte(
  249.                 CompareStr(ValueTable[IndexL], ValueTable[IndexR]) > 0));
  250.             LteChar : ValueTable[IndexL]:=IntToStr(byte(
  251.                 CompareStr(ValueTable[IndexL], ValueTable[IndexR]) <= 0));
  252.             GteChar : ValueTable[IndexL]:=IntToStr(byte(
  253.                 CompareStr(ValueTable[IndexL], ValueTable[IndexR]) >= 0));
  254.           end
  255.         else
  256.           case Result[Operator] of
  257.             EqChar : ValueTable[IndexL]:=IntToStr(byte(
  258.                 StrToNum(ValueTable[IndexL]) = StrToNum(ValueTable[IndexR])));
  259.             NeqChar : ValueTable[IndexL]:=IntToStr(byte(
  260.                 StrToNum(ValueTable[IndexL]) <> StrToNum(ValueTable[IndexR])));
  261.             LtChar : ValueTable[IndexL]:=IntToStr(byte(
  262.                 StrToNum(ValueTable[IndexL]) < StrToNum(ValueTable[IndexR])));
  263.             GtChar : ValueTable[IndexL]:=IntToStr(byte(
  264.                 StrToNum(ValueTable[IndexL]) > StrToNum(ValueTable[IndexR])));
  265.             LteChar : ValueTable[IndexL]:=IntToStr(byte(
  266.                 StrToNum(ValueTable[IndexL]) <= StrToNum(ValueTable[IndexR])));
  267.             GteChar : ValueTable[IndexL]:=IntToStr(byte(
  268.                 StrToNum(ValueTable[IndexL]) >= StrToNum(ValueTable[IndexR])));
  269.           end;
  270.         Delete(Result, Operator, 2);
  271.       end;
  272.     until Operator = 0;
  273.  
  274.     {**************** Load Result from ValueTabl **************}
  275.     IndexL:=Length(Result);
  276.     for Operator:=1 to IndexL do
  277.       AppendStr(Result, ValueTable[Ord(Result[Operator])]);
  278.     Result:=Copy(Result, IndexL + 1, 255);
  279.  
  280.   {********************** Free Objects ************************}
  281.   finally
  282.     ValueTable.Free;
  283.     AScanner.Free;
  284.     AStream.Free;
  285.   end;
  286. end;
  287.  
  288. end.
  289.  
  290.